home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The Essential Home & Business Collection
/
The Essential Home & Business Collection.iso
/
26
/
3
/
4
/
APLIB.ZIP
/
PUBVARS.BAS
< prev
next >
Wrap
BASIC Source File
|
1990-07-03
|
6KB
|
228 lines
' FIND ALL THE "EXTERNAL" VARIABLES IN YOUR UNIT FILES
' AND MAKE AN ALPHABETIZED LIST OF THEM,
' IN THE FORM "PUBLIC ...
' PUBLIC ... "
' TO "$INCLUDE" IN THE MAIN FILE
' -- Howard Ballinger, 4-22-90
' Soooo ... Just as soon as I'd uploaded the first version of this I said
' to my Self -- or my Self said to me -- Why not have it read the
' main program first and get its own unit filenames, instead of
' me having to type 'em in? This, then, is the Improved Version !!
' -- 5-12-90
$COMPILE EXE
$ERROR ALL OFF
$LIB ALL OFF
%False = 0
%True = NOT %False
DEFINT A-Z
DIM V$ (1:1000)
DIM UnitName$ (1:30)
COLOR 14,0
CLS
LOCATE 2,1
PRINT " HB PUBLIC VARIABLE LISTER
PRINT " =======================
PRINT
COLOR 2,0
FILES "*.BAS"
GetFileName:
DO
COLOR 14,0
LOCATE 25,1
INPUT " MAIN FILE TO SEARCH FOR UNIT NAMES (CR to quit):"; MainFile$
LOCATE 25,1: PRINT SPACE$ (80);
IF MainFile$ = "" THEN STOP
MainFile$ = UCASE$ (MainFile$)
IF INSTR (MainFile$, ".") = 0 THEN MainFile$ = MainFile$ + ".BAS"
IF EXIST (MainFile$) THEN EXIT LOOP
LOCATE 20,26: PRINT "<<< ERROR OPENING FILE !! >>"
DELAY 3
LOCATE 20,26: PRINT " "
LOOP
MainFile% = FREEFILE
OPEN MainFile$ FOR INPUT AS MainFile%
CLS
LOCATE 2,1
PRINT " HB PUBLIC VARIABLE LISTER
PRINT " =======================
PRINT
COLOR 29,0
L0 = CSRLIN: C0 = POS
PRINT " Searching ";MainFile$; " ...": PRINT
COLOR 14,0
DO WHILE NOT EOF (MainFile%) ' search source file for units to be linked
LINE INPUT #MainFile%, W$
INCR Ln
W$ = LTRIM$ (W$, ANY CHR$ (32, 9)) ' strip spaces & tabs
IF UCASE$ (LEFT$ (W$, 5)) = "$LINK" THEN
PRINT USING " line ####: \ \"; Ln, W$
W$ = MID$ (W$, 6)
W$ = LTRIM$ (W$, ANY CHR$ (32, 34)) ' strip spaces & quotes
W$ = RTRIM$ (W$, ANY CHR$ (32, 34))
INCR File%
REPLACE ".PBU" WITH ".BAS" IN W$
REPLACE ".pbu" WITH ".bas" IN W$
UnitName$ (File%) = W$
END IF
LOOP
L1 = CSRLIN: C1 = POS
LOCATE L0, C0
PRINT " Searching ";MainFile$; " ...": PRINT
LOCATE L1 + 1, 38
PRINT "Done."
CLOSE #MainFile%
DELAY 1
OutFile$ = EXTRACT$ (MainFile$, ".") + ".PV"
BakFile$ = EXTRACT$ (MainFile$, ".") + ".&PV"
IF EXIST (BakFile$) THEN
L0 = CSRLIN: C0 = POS
LOCATE 22,1
PRINT " THERE'S A FILE NAMED ";BakFile$;" IN THIS DIRECTORY."
PRINT " PRESUMABLY IT'S AN OLD BACKUP PUBVARS LIST. OVERWRITE IT ? (y/n) ";
DO: K$ = UCASE$ (INKEY$): LOOP UNTIL K$ = "Y" OR K$ = "N" OR K$ = CHR$ (27)
PRINT K$
IF K$ = "Y" THEN
KILL BakFile$
FOR L = 18 TO 25: LOCATE L, 1: PRINT SPACE$ (80);: NEXT
LOCATE L0, C0
PRINT " "; BakFile$; " Deleted "
ELSE
PRINT
PRINT "TO PRESERVE THE FILE ";BakFile$;" PLEASE RENAME IT, THEN START OVER"
STOP
END IF
END IF
PRINT
IF EXIST (OutFile$) THEN
PRINT " Renaming "; OutFile$; " as "; BakFile$
NAME OutFile$ AS BakFile$
END IF
File% = 0
DO
INCR File%
InputFile$ = UnitName$ (File%)
IF InputFile$ = "" THEN
IF V$ (1) <> "" THEN
LOCATE 23,46: PRINT "WRITING TO FILE "; OutFile$;
OutputFile% = FREEFILE
OPEN OutFile$ FOR APPEND AS OutputFile%
Ind = 1
DO
PRINT #OutputFile, V$ (Ind)
INCR Ind
LOOP UNTIL V$ (Ind) = ""
END IF
COLOR 3,0
LOCATE 24,1: PRINT SPACE$ (80);
LOCATE 25,1: PRINT SPACE$ (80);
LOCATE 22,1
STOP
END IF
ARRAY SCAN V$ (), = "", TO FirstBlank
Ind = FirstBlank ' because this array doesn't start w/ 0
InputFile$ = UCASE$ (InputFile$)
InputFile% = FREEFILE
OPEN InputFile$ FOR INPUT AS InputFile%
GOSUB Status
V$ (Ind) = "' UNIT FILE SEARCHED: " + InputFile$
INCR Ind
Ln = 0
DO WHILE NOT EOF (InputFile%)
LINE INPUT #InputFile%, W$
INCR Ln
GOSUB Status
W$ = LTRIM$ (W$, ANY CHR$(9, 32)) ' again remove spaces & tabs
IF UCASE$ (LEFT$ (W$, 8)) = "EXTERNAL" THEN
W$ = MID$ (W$,9)
DO ' chop off each variable name (up to comma)
W$ = LTRIM$ (W$)
Comma = INSTR (W$, ",")
IF Comma THEN
V$ (Ind) = "PUBLIC " + LEFT$ (W$, Comma-1)
W$ = MID$ (W$, Comma+1)
ELSE
V$ (Ind) = "PUBLIC " + W$
END IF
INCR Ind
INCR Vars%
GOSUB Status
LOOP WHILE Comma
END IF
LOOP
ARRAY SORT V$ () FOR Ind - 1, COLLATE UCASE
Ind = 1
DO UNTIL V$ (Ind) = ""
IF V$ (Ind) = V$ (Ind + 1) THEN
INCR Dups%
DECR Vars%
ARRAY DELETE V$ (Ind)
GOSUB Status
END IF
INCR Ind
LOOP
N$ = "NEXT "
LOOP
Status:
COLOR 14,4
LOCATE 24,1
PRINT USING " Searching: \ \ Line: #### " ; InputFile$, Ln;
LOCATE 25,1
PRINT USING_
" EXTERNAL Vars Found: ### Duplicates Removed: ### ";_
Vars%, Dups%;
RETURN
FUNCTION EXIST (F$)
%FLAGS = 0: %AX = 1: %BX = 2: %CX = 3: %DX = 4
%SI = 5: %DI = 6: %BP = 7: %DS = 8: %ES = 9
LOCAL SearchErr, FZ$
FZ$ = F$ + CHR$(0)
REG %DS, STRSEG (FZ$)
REG %DX, STRPTR (FZ$)
REG %CX, &H17
REG %AX, &H4E00
CALL INTERRUPT &H21
SearchErr = REG(%AX)
SELECT CASE SearchErr
CASE 2, 3, 15, 18
EXIST = 0
CASE ELSE
EXIST = -1
END SELECT
DEF SEG
END Function